(SETQ IBASE (ADD1 7)) 


(DEFPROP ALLFNS 
 (NIL BN
      VB
      FN
      EN
      QUIET
      DISPLAYFLAG
      MARK
      TYPE/.
      CLRGEM
      SAVE
      GEOINIT
      FOO
      DEBUGFLAG
      WAIT
      RUNNER
      FATAL
      TJOINT
      K1
      G
      FOLDED
      VISIBLE
      POTENT
      JOTBIT
      JUTBIT
      EBIT
      BBIT
      MAKETILE
      DETSEG
      SHOW9
      *TEST
      EXCH
      SEENOD
      GLUETILE
      TEST2
      TEST
      TYPE
      COPYPOS
      GARG) 
VALUE)

(DEFPROP BN 
 (LAMBDA(N)
  (PROG (B)
	(SETQ B WORLD)
   LOOP (SETQ B (CCW B))
	(COND ((*GREAT (SETQ N (SUB1 N)) 0) (GO LOOP)) (T (RETURN B))))) 
EXPR)

(DEFPROP FN 
 (LAMBDA(B N)
  (PROG NIL LOOP (SETQ B (PFACE B)) (COND ((*GREAT (SETQ N (SUB1 N)) 0) (GO LOOP)) (T (RETURN B))))) 
EXPR)

(DEFPROP EN 
 (LAMBDA (B N) (PROG NIL LOOP (SETQ B (PED B)) (COND ((*GREAT (SETQ N (SUB1 N)) 0) (GO LOOP)) (T (RETURN B))))) 
EXPR)

(DEFPROP QUIET 
 (LAMBDA(L)
  (PROG (DISPLAYFLAG DEBUGFLAG) (SETQ DEBUGFLAG NIL) (SETQ DISPLAYFLAG NIL) (MAPC (FUNCTION EVAL) L))) 
FEXPR)

(DEFPROP DISPLAYFLAG 
 (NIL) 
VALUE)

(DEFPROP MARK 
 (LAMBDA (V BITS) (TYPE/. V (BOOLE 7 (TYPE V) BITS))) 
EXPR)

(DEFPROP TYPE/. 
 (LAMBDA (N V) (ZWC/. (ADD1 N) V)) 
EXPR)

(DEFPROP CLRGEM 
 (LAMBDA NIL (UNTIL (EQ WORLD (CCW WORLD)) (KLB (CCW WORLD)))) 
EXPR)

(DEFPROP SAVE 
 (LAMBDA (L) (EVAL (LIST (QUOTE DSKOUT) (CAR L) (QUOTE (PROG2 (GRINL ALLFNS) (PRINT (QUOTE (GEOINIT)))))))) 
FEXPR)

(DEFPROP GEOINIT 
 (LAMBDA NIL (PROG2 START (DEPOSIT 124 (MAKNUM (GETQ START VALUE) (QUOTE FIXNUM))) (GEONIT) (DETSEG))) 
EXPR)

(DEFPROP FOO 
 (LAMBDA(L)
  (PROG NIL
	(MAPC (FUNCTION (LAMBDA (L) (GPUSH (EVAL L)))) L)
	(STADPY)
	(MAPC (FUNCTION (LAMBDA (L) (GPOP L))) L))) 
FEXPR)

(DEFPROP DEBUGFLAG 
 (NIL) 
VALUE)

(DEFPROP WAIT 
 (LAMBDA(L)
  (COND (DEBUGFLAG
	 (PROG (TMP TMP2)
	       (SETQ TMP (DDTIN T))
	       (SETQ TMP2 (TYI))
	       (DDTIN TMP)
	       (COND ((EQ TMP2 104) (PROG2 (PRINL L) (BREAK (WAIT)) (TYI))) (T NIL))))
	(T NIL))) 
FEXPR)

(DEFPROP RUNNER 
 (LAMBDA NIL
  (PROG NIL
	(SHOW9 1)
	(TEST2)
	(PRINQ PASS 1 COMPLETED /././.)
	(*TEST)
	(PRINQ PASS2 COMPLETED)
	(TERPRI)
	(KLTMPS WORLD)
	(GEODPY)
	(GPUSH IMAGE)
	(STADPY))) 
EXPR)

(DEFPROP RUNNER 
 #151 
VALUE)

(DEFPROP FATAL 
 (LAMBDA (L) (PROG2 NIL (PRINL L) (BREAK (FATAL)) (FIX T))) 
FEXPR)

(DEFPROP TJOINT 
 (LAMBDA (N) (NED N)) 
EXPR)

(DEFPROP K1 
 (NIL . 0.13671875E-1) 
VALUE)

(DEFPROP G 
 (LAMBDA NIL (PROG2 (COND ((EQ WORLD 0) (GEOINIT)) (T NIL)) (GEOMED))) 
EXPR)

(DEFPROP FOLDED 
 (NIL . 100000000) 
VALUE)

(DEFPROP VISIBLE 
 (NIL . 40000000) 
VALUE)

(DEFPROP POTENT 
 (NIL . 20000000) 
VALUE)

(DEFPROP JOTBIT 
 (NIL . 20000000000) 
VALUE)

(DEFPROP JUTBIT 
 (NIL . 40000000000) 
VALUE)

(DEFPROP EBIT 
 (NIL . 4000000) 
VALUE)

(DEFPROP BBIT 
 (NIL . 1000000) 
VALUE)

(DEFPROP MAKETILE 
 (LAMBDA(CALLFACE)
  (PROG (FACE E0 E1 FNEW VNEW V0 VT JOTFLAG)
	(COND (DISPLAYFLAG (PROG2 (GPUSH CALLFACE) (STADPY) (GPOP))) (T NIL))
	(SETQ E0 (SETQ E1 (PED CALLFACE)))
	(SETQ E1 E0)
   VSLOOP
	(COND ((TEST E1 VISIBLE) NIL)
	      ((EQUAL E0 (SETQ E1 (ECCW E1 CALLFACE)))
	       (RETURN (PROG2 (PRINQ POTENT FACE WITHOUT VISIBLE EDGE FOUND) 0)))
	      (T (GO VSLOOP)))
	(SETQ JOTFLAG NIL)
	(SETQ FACE CALLFACE)
	(SETQ E0 E1)
	(SETQ FNEW (MKF IMAGE))
	(SETQ VNEW (MKV IMAGE))
	(SETQ V0 VNEW)
   LOOP (COPYPOS VNEW (VCCW E1 FACE))
	(COND (DISPLAYFLAG (PROG NIL (GPUSH FACE) (GPUSH E1) (STADPY) (WAIT MAKETILE 1) (GPOP) (GPOP)))
	      (T NIL))
	(COND
	 (JOTFLAG
	  (COND
	   ((AND (TEST (VCCW E1 FACE) (*PLUS JUTBIT JOTBIT))
		 (OR (TEST (PED (SETQ VT (TJOINT (VCCW E1 FACE)))) VISIBLE) (TEST (ECCW (PED VT) VT) VISIBLE)))
	    (PROG NIL
		  (SETQ FACE (PFACE (PED VT)))
		  (COND ((TEST FACE POTENT)
			 (COND ((EQUAL FACE CALLFACE) (SETQ JOTFLAG NIL)) (T (SETQ FACE (NFACE (PED VT))))))
			((EQUAL (NFACE (PED VT)) CALLFACE) (PROG NIL (SETQ FACE CALLFACE) (SETQ JOTFLAG NIL)))
			(T NIL))
		  (SETQ E1 (ECCW VT FACE))))
	   (T
	    (PROG NIL
		  (SETQ VT (VCCW E1 FACE))
 	     ELOOP
		  (COND ((TEST (SETQ E1 (ECW E1 VT)) VISIBLE) NIL) (T (GO ELOOP)))
		  (SETQ FACE (FCCW E1 VT))))))
	 ((TEST (ECCW E1 FACE) VISIBLE) (SETQ E1 (ECCW E1 FACE)))
	 ((NULL (EQUAL (TJOINT (SETQ VT (VCCW E1 FACE))) 0))
	  (PROG NIL
		(SETQ VT (TJOINT VT))
		(COND (DISPLAYFLAG (PROG2 (GPUSH VT) (STADPY) (GPOP))) (T NIL))
		(SETQ FACE (PFACE (PED VT)))
		(COND ((TEST FACE POTENT) (SETQ FACE (NFACE (PED VT)))) (T NIL))
		(SETQ E1 (ECCW VT FACE))
		(SETQ JOTFLAG T)))
	 (T
	  (PROG NIL
		(SETQ E1 (ECCW E1 FACE))
 	   ELOOP
		(COND (DISPLAYFLAG (PROG NIL (GPUSH VT) (GPUSH E1) (STADPY) (GPOP) (GPOP))) (T NIL))
		(COND ((TEST (SETQ E1 (ECW E1 VT)) VISIBLE) NIL) (T (GO ELOOP)))
		(SETQ FACE (FCCW E1 VT))
		(SETQ JOTFLAG T))))
	(COND ((EQUAL E0 E1)
	       (RETURN
		(PROG NIL
		      (SETQ E0 (INVERT (MKFE V0 FNEW VNEW)))
		      (ALT/. E1 E0)
		      (ALT/. E0 E1)
		      (SETQ FNEW (PFACE FNEW))
		      (TYPE/. (PLUS FNEW 7) (EXAMINE (PLUS FACE 7)))
		      (ALT/. FACE FNEW)
		      (ALT/. FNEW FACE)
		      (RETURN FNEW))))
	      (T (SETQ VNEW (MKEV FNEW VNEW))))
	(ALT/. E1 (PED VNEW))
	(ALT/. (PED VNEW) E1)
	(GO LOOP))) 
EXPR)

(DEFPROP DETSEG 
 (LAMBDA NIL (UUO 400017)) 
EXPR)

(DEFPROP SHOW9 
 (LAMBDA(POG)
  (PROG NIL (PPROJ CAMERA WORLD) (FMRK WORLD) (EMRK WORLD) (OCCULT WORLD) (CLIPER WINDOW) (IIIDPY WINDOW POG))) 
EXPR)

(DEFPROP *TEST 
 (LAMBDA NIL
  (PROG (E1 E2)
	(SETQ E1 (PED IMAGE))
   LOOP (PROG2 (GPUSH (ALT E1)) (STADPY) (GPOP))
	(COND ((EQUAL E1 (SETQ E2 (ALT (ALT E1)))) NIL)
	      ((NULL (TEST E1 EBIT)) (FATAL E1 NOT AN EDGE))
	      ((NULL (TEST E2 EBIT)) (FATAL E2 NOT AN EDGE))
	      (T (PROG NIL (GLUETILE E2 E1) (ALT/. (ALT E1) E1))))
	(COND ((EQUAL (SETQ E1 (PED E1)) IMAGE) (RETURN)) (T (GO LOOP))))) 
EXPR)

(DEFPROP EXCH 
 (LAMBDA (L) (PROG (TMP) (SETQ TMP (EVAL (CAR L))) (SET (CAR L) (EVAL (CADR L))) (SET (CADR L) TMP))) 
FEXPR)

(DEFPROP SEENOD 
 (LAMBDA (L) (PROG NIL (GPUSH L) (GEODPY) (STADPY) (GPOP))) 
EXPR)

(DEFPROP GLUETILE 
 (LAMBDA(E1 E2)
  (PROG (UF1 UF2 ENEW1 ENEW2 V1 V2 U1 U2)
	(SETQ V1 (NVT E1))
	(SETQ V2 (PVT E1))
	(SETQ U1 (PVT E2))
	(SETQ U2 (NVT E2))
	(SETQ UF1 (NFACE E1))
	(SETQ UF2 (NFACE E2))
	(RETURN
	 (COND ((AND (EQUAL V1 U1) (EQUAL V2 U2)) (PROG NIL (KLFE E1) (RETURN E2)))
	       ((OR (EQUAL V1 U1) (EQUAL V2 U2))
		(PROG NIL
		      (COND ((EQUAL V2 U2) (SETQ ENEW1 (MKFE U1 UF1 V1))) (T (SETQ ENEW1 (MKFE V2 UF1 U2))))
		      (KLFE E1)
		      (KLVE ENEW1)
		      (RETURN E2)))
	       ((OR (EQUAL V1 U2) (EQUAL V2 U1)) (BREAK (EDGE BACKWARDS AT GLUETILE)))
	       ((EQUAL UF1 UF2)
		(PROG NIL
		      (WAIT GLUETILE (NEW))
		      (SETQ ENEW1 (MKFE U1 UF1 V1))
		      (SETQ ENEW2 (MKFE U2 UF1 V2))
		      (KLFE E1)
		      (KLVE ENEW1)
		      (KLVE ENEW2)
		      (RETURN E2)))
	       (T
		(PROG NIL
		      (WAIT)
		      (SETQ ENEW1 (GLUEE UF1 V1 UF2 U1))
		      (SETQ ENEW2 (MKFE V2 UF1 U2))
		      (KLFE E1)
		      (KLVE ENEW1)
		      (KLVE ENEW2)
		      (RETURN E2))))))) 
EXPR)

(DEFPROP TEST2 
 (LAMBDA NIL
  (PROG (FACE)
	(SETQ IMAGE (MKB WORLD))
	(SETQ FACE (PFACE WORLD))
   LOOP (MAKETILE FACE)
	(SETQ FACE (ALT2 FACE))
	(COND ((EQ FACE 0) (RETURN T)) (T (GO LOOP))))) 
EXPR)

(DEFPROP TEST 
 (LAMBDA (NODE BITS) (NOT (EQ (BOOLE 1 (TYPE NODE) BITS) 0))) 
EXPR)

(DEFPROP TYPE 
 (LAMBDA (N) (ZWC (ADD1 N))) 
EXPR)

(DEFPROP COPYPOS 
 (LAMBDA(VNEW VOLD)
  (PROG NIL
	(ZWC/. VNEW 0)
	(XWC/. VNEW (*TIMES K1 (XDC VOLD)))
	(YWC/. VNEW (*TIMES K1 (YDC VOLD)))
	(XDC/. VNEW (XDC VOLD))
	(YDC/. VNEW (YDC VOLD)))) 
EXPR)

(DEFPROP GARG 
 (LAMBDA (N) (EXAMINE (*DIF (BOOLE 1 PDLPTR 777777) (SUB1 N)))) 
EXPR)

(GEOINIT)